home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / brklyprl.lha / Comp / pipeplm.pl < prev    next >
Encoding:
Text File  |  1989-04-14  |  2.0 KB  |  76 lines
  1.  
  2. /* Copyright (C) 1988, 1989 Herve' Touati, Aquarius Project, UC Berkeley */
  3.  
  4. /* Copyright Herve' Touati, Aquarius Project, UC Berkeley */
  5.  
  6. /***********************************************************************/
  7. /* Piped compiler: (Quintus only) */
  8. :- dynamic(save_clause/1).
  9. save_clause(none).
  10.  
  11. main :-
  12.     save(comp,1),
  13.     init_compile,
  14.     compileall,
  15.     halt.
  16. main.
  17.  
  18. init_compile :-
  19.     set(dummy_counter,0),
  20.     read_one(Clause),
  21.     set(save_clauses,[Clause]).
  22.  
  23. compileall :-
  24.     read_proc(NameAr, Proc),
  25.         gc(compileproc(NameAr, Proc, Code-[])),
  26.         write_plm(NameAr, Code),
  27.     compileall.
  28. compileall.
  29.  
  30. read_proc(NameAr, NewProc) :-
  31.     access(save_clauses,Saved),
  32.     read_proc(Saved, NameAr, NewProc).
  33.  
  34. read_proc([end_of_file], _, _) :- !, fail.
  35. read_proc(Saved, NameAr, NewProc) :-
  36.     read_proc(Saved, Proc, NameAr, NextCls),
  37.     eliminate_disjunctions(Proc,NewProc,NewClauses,Link),
  38.     Link = NextCls,
  39.     set(save_clauses,NewClauses).
  40.  
  41. % first arg: list of clauses read the time before
  42. % second arg: result
  43. % third argument: Name/Arity of result
  44. % fourth arg: list of clauses read in advance
  45. read_proc([C|Cs], [C|NewCs], NameAr, NextCs) :-
  46.     getname(C, NameAr), !,
  47.     read_proc(Cs, NewCs, NameAr, NextCs).
  48. read_proc([C|Cs], [], _, [C|Cs]).
  49. read_proc([], NewCs, NameAr, NextCs) :-
  50.     read_one(NewC),
  51.     (getname(NewC, NameAr) ->
  52.         NewCs = [NewC|Rest], read_proc([],Rest,NameAr,NextCs);
  53.         NewCs = [], NextCs = [NewC]).
  54.  
  55. read_one(Clause) :-
  56.         read(Cl),
  57.         (Cl=(:-(Directive)) ->
  58.                 handle_directive(Directive),
  59.                 read_one(Clause);
  60.     Clause = Cl), !.
  61.  
  62. handle_directive(option(OptList)) :- piped_options(OptList), !.
  63. handle_directive(X) :- X.
  64.  
  65. % Add options to data base:
  66. piped_options(Opt) :-
  67.     \+((Opt==[]; nonvar(Opt),Opt=[_|_])), !, piped_options([Opt]).
  68. piped_options(OptionList) :-
  69.     set(2, []),
  70.         full_list(OptionList), add_options(OptionList), !.
  71. piped_options(_) :-
  72.         write('/***** ERROR IN OPTION FORMAT *****/'),nl,        
  73.         halt, !.
  74.  
  75. /***********************************************************************/
  76.